perm filename XFORMS.16[NET,KMC] blob
sn#165196 filedate 1975-06-20 generic text, type T, neo UTF8
(FILECREATED "12-DEC-73 07:22:41" LISP15.XFORMS)
(LISPXPRINT (QUOTE XFORMSVARS)
T)
(RPAQQ XFORMSVARS ((TRANSAVE)
(FNS RD RD1 RDLST RDLST1 QREAD)
(ADVISE UREAD)))
(RPAQQ DUMPFILE LISP15.XFORMS)
[RPAQQ USERNOTES ((*RSET: (* %% THIS IS MEANINGLESS IN INTERLISP; THE
BREAK PACKAGE DECIDES WHEN TO BREAK))
(ARRAY: (* %% THERE IS AN ARRAY FUNCTION IN INTERLISP, BUT IT
ALLOWS ONLY ONE DIMENSIONAL ARRAYS))
(BLAMBDA (* THIS EXPRESSION HAS CAR-OF-FORM A LIST; IF THIS
IS AN EVALUATION OF WHAT TO APPLY, APPLY* MUST BE
USED; I.E. INTERLISP DOES NOT COMPUTE THE
FUNCTION NAME))
(CHRCT: (* %% TRY USING "POSITION"))
(CSYM: (* %% THE INTERLISP GENSYM TAKES AN OPTIONAL ARGUMENT
WHICH IS IT'S INITIAL CHARACTER, AND ALSO USES THE
VALUE OF THE VARIABLE GENNUM; THE FUNCTION OF CSYM
CAN BE DUPLICATED BY THE MANIPULATION OF THE GENSYM
ARG AND GENNUM; BUT THIS HAS BEEN LEFT TO YOU TO DO)
)
(DM: (* %% MACROS IN THE LISP 1.6 SENSE ARE NOT AVAILABLE;
SORRY, THIS MUST BE DONE SOME OTHER WAY))
(EXAMINE: (* %% YOU PROBABLY NO LONGER WANT TO DO THIS, AS
THINGS AREN'T STORED THE SAME WAY))
(FUNNYBOOLE (* %% THE GENERAL FUNCTION BOOLE HAS NO
EQUIVALENT IN INTERLISP; LOGAND, LOGOR, AND
LOGXOR ARE TRANSLATED; BUT ALL OTHERS HAVE
BEEN LEFT FOR YOU TO RECODE))
(INITFN: (* %% YOU CAN DO THIS WITH LISPXUSRFN, ETC))
(INTERN (*
%% IT IS IMPOSSIBLE TO CREATE ATOMS IN INTERLISP
WHICH ARE NOT ON THE INTERNAL "OBLIST" ; THUS
MAKNUM AND READLIST ARE EQUIVALENT IN INTERLISP))
(IO (* %% THIS IO FUNCTION I HAVENT TRANSLATED, LEAVING IT TO
YOU TO DECIDE WHAT TO DO))
(LABEL: (* %% THE LABEL FEATURE IS NOT AVAILABLE IN
INTERLISP; THIS MUST BE DEFINED AS A FUNCTION AND
THE LABEL CHANGED TO A CALL TO THAT FUNCTION))
(LAP: (* %% YOU WANT TO REFORMAT THE LAP CODE TO THE
SPECIFICATIONS OF ASSEMBLE IN THE INTERLISP MANUAL))
(LAZY (* %% I AM TOO LAZY TO DEFINE A TRANSFORMATION FOR
THIS; YOU CAN FIX IT YOURSELF))
(LGREATERP/LLESSP (* %% NO CORRESPONDING FUNCTIONS EXIST TO
THE N-ARGUMENT GREATERP OR LESSP;
HOWEVER ONE CAN DEFINE LGREATERP
(LLESSP)
AS
[LAMBDA N ...]
ITEM))
(LQUOTIENT (*
%% THERE IS NO CORRESPONDING FUNCTION TO THE
N-ARGUMENT QUOTIENT IN INTERLISP; YOU CAN DEFINE
ONE AS "LQUOTIENT" HERE IF YOU LIKE))
(MAKNUM (* %% INTERLISP HAS NO FACILITY FOR CREATING LISTS
FROM LISTS OF CHARACTERS; I.E. IN LISP 1.6 MAKNUM
APPLIED TO (%( A %))
WOULD CREATE A LIST OF ONE ELEMENT A; THE PACK
THAT THIS MAKNUM/MAKNAM HAS BEEN TRANSLATED TO
WILL JUST CREATE AN ATOM WITH THREE CHARACTERS;
LEFT PAREN, A, AND RIGHT PAREN. EXAMINE THE CODE
CAREFULLY TO MAKE SURE THAT THIS IS O.K;
OTHERWISE, THIS NEEDS TO BE RECODED))
(NOBCP (* %% BINDING CONTEXT POINTERS ARE NOT AVAILABLE IN
INTERLISP; ALTHOGH SIMILAR THINGS CAN BE DONE WITH
FUNARGS AND WITH STACK POINTERS, NO GOOD GENERAL
WAY OF TRANSLATING THESE PRESENTS ITSELF TO ME))
(SASSOC: (* %% THE LISP 1.6 SASSOC IS NOT AVAILABLE IN
INTERLISP ; IT HAS BEEN CHANGED HERE TO SASSOC',
WHICH YOU MAY DEFINE))
(STORE: (* %% TRY SETA, SETD, ETC))
(T: (* %% THIS IS AN ERROR]
(RPAQQ NLISTPCOMS NIL)
(RPAQQ LAMBDACOMS ((IF (NEQ (## 1 1)
(QUOTE LAMBDA))
((REMARK BLAMBDA))
(NIL))
DOTHESE))
(RPAQQ TRANSFORMATIONS
(*APPEND *DIF *EVAL *FUNCTION *GREAT *LESS *PLUS *QUO *RSET
*TIMES ADD1 ARRAY ASCII BOOLE CHRCT COND CSYM DDTIN
DE DEPOSIT DF DIVIDE DM EQUAL ERR ERRSET EXAMINE
EXARRAY EXPLODE FLATSIZE GCD GET GETL GREATERP
GRINDEF INC INITFN INPUT INTERN LABEL LAMBDA LAP
LESSP LLESSP MAKNAM MAKNUM MAP MAPC MAPCAR MAPLIST
MEMBER MEMQ NCONS OR OUTC OUTPUT PRIN1 PRINC PROG
PUTPROP QUOTIENT READLIST REMOB SASSOC SETQ SPRINT
STORE T TIME TYI TYO XCONS ZEROP))
(DEFLIST(QUOTE(
(*APPEND ((1 APPEND)))
(*DIF ((1 DIFFERENCE)))
(*EVAL ((1 EVAL)))
(*FUNCTION ((REMARK NOBCP)))
(*GREAT ((1 GREATERP)))
(*LESS ((1 LESSP)))
(*PLUS ((1 PLUS)))
(*QUO ((1 QUOTIENT)))
(*RSET ((REMARK *RSET:)))
(*TIMES ((1 TIMES)))
(ADD1 ((1 PLUS)
(N 1)))
(ARRAY ((REMARK LAZY)
(REMARK ARRAY:)))
(ASCII ((1 CHARACTER)))
[BOOLE ((1)
[I 1 (SELECTQ (## 1)
(1 (QUOTE LOGAND))
(7 (QUOTE LOGOR))
(6 (QUOTE LOGXOR))
(LIST (QUOTE BOOLE)
(## 1]
(IF (LISTP (## 1))
((REMARK FUNNYBOOLE]
(CHRCT ((REMARK IO)
(REMARK CHRCT:)))
(COND (1 (LPQ NX DOTHESE)))
(CSYM ((REMARK CSYM:)))
(DDTIN ((REMARK IO)))
(DE ((1 DEFINEQ)
(LI 2)
2 2 DOTHIS))
(DEPOSIT ((REMARK EXAMINE:)))
(DF ((1 DEFINEQ)
(LI 2)
(LI 2)
2 1 (-2 NLAMBDA)
(LI 2)
2 2 (IF (## 2)
((REMARK NOBCP))
(NIL))
(XTR 1)
NX DOTHIS))
(DIVIDE ((REMARK LAZY)))
(DM ((REMARK DM:)))
[EQUAL ((IF (NUMBERP (## 2))
((1 EQP))
((IF (NUMBERP (## 3))
((1 EQP))
(NIL]
[ERR ((IF (## 2)
((1 RETFROM (QUOTE ERRORSET)))
((1 ERROR!)
(2]
(ERRSET ((1 NLSETQ)))
(EXAMINE ((REMARK EXAMINE:)))
(EXARRAY ((REMARK LAZY)))
(EXPLODE ((1 UNPACK)))
(FLATSIZE ((1 NCHARS)))
(GCD ((REMARK LAZY)))
(GET ((1 GETP)))
(GETL ((1 GETLIS)))
(GREATERP ((1 LGREATERP)
(REMARK LGREATERP/LLESSP)))
(GRINDEF ((1 PP)))
(INC ((REMARK IO)))
(INITFN ((REMARK INITFN:)))
(INPUT ((REMARK IO)))
(INTERN ((REMARK INTERN)))
(LABEL ((REMARK LABEL:)))
[LAMBDA (3 DOTHIS]
(LAP ((-1 HELP)
(REMARK LAP:)))
(LESSP ((1 LLESSP)))
[LLESSP ((REMARK LGREATERP/LLESSP)
(IF (VALCONTEXT)
(FIXT)
(NIL]
(MAKNAM ((1 PACK)
(REMARK INTERN)
(REMARK MAKNUM)))
(MAKNUM ((1 PACK)
(REMARK MAKNUM)
(REMARK INTERN)))
(MAP ((SW 2 3)))
(MAPC ((SW 2 3)))
(MAPCAR ((SW 2 3)))
(MAPLIST ((SW 2 3)))
[MEMBER ((IF (VALCONTEXT)
(FIXT)
(NIL]
[MEMQ ((1 MEMB)
(IF (VALCONTEXT)
(FIXT)
(NIL]
(NCONS ((1 CONS)))
[OR ((IF (VALCONTEXT)
(FIXT)
(NIL]
(OUTC ((REMARK IO)))
(OUTPUT ((REMARK IO)))
(PRIN1 ((1 PRIN2)))
(PRINC ((1 PRIN1)))
(PROG (3 (LPQ (IF (LISTP (##))
(DOTHIS)
NIL)
NX)))
(PUTPROP ((1 PUT)
(SW 3 4)))
(QUOTIENT ((IF (## 3)
((REMARK LQUOTIENT))
(NIL))
(1 LQUOTIENT)))
(READLIST ((1 PACK)
(REMARK MAKNUM)))
(REMOB ((REMARK INTERN)))
(SASSOC ((1 SASSOC')
(REMARK SASSOC:)))
(SETQ (3 DOTHIS))
(SPRINT ((1 PRINTDEF)))
(STORE ((REMARK LAZY)
(REMARK STORE:)))
(T ((REMARK T:)))
(TIME ((1 CLOCK 0)))
(TYI ((REMARK IO)))
(TYO ((REMARK IO)))
[XCONS ((1 (LAMBDA (X Y)
(CONS Y X]
(ZEROP ((1 EQP)
(N 0)))
))(QUOTE XFORM))
[COND [(EQ (EVALV (QUOTE MERGE))
T)
[RPAQ TRANSFORMATIONS (UNION TRANSFORMATIONS
(LISTP (GETP (QUOTE
TRANSFORMATIONS)
(QUOTE VALUE]
(MAPC (GETP (QUOTE USERNOTES)
(QUOTE VALUE))
(FUNCTION (LAMBDA (NOTE)
(OR (ASSOC (CAR NOTE)
USERNOTES)
(SETQ USERNOTES (CONS NOTE
USERNOTES]
(T (MAPC (GETP (QUOTE TRANSFORMATIONS)
(QUOTE VALUE))
(FUNCTION (LAMBDA (X)
(AND (NOT (MEMB X TRANSFORMATONS))
(/REMPROP X (QUOTE XFORM]
(DEFINEQ
(RD
[LAMBDA NIL
(RD1 (RDA])
(RD1
[LAMBDA (AT)
(SELECTQ AT
(%( (RDLST))
(%[ (HELP))
AT])
(RDLST
[LAMBDA NIL
(RDLST1 (RDA])
(RDLST1
[LAMBDA (AT)
(SELECTQ AT
[%. (PROG1 (RD)
(OR (EQ (RDA)
(QUOTE %)))
(HELP]
(%) NIL)
(%] (HELP))
(CONS (RD1 AT)
(RDLST])
(QREAD
[LAMBDA (FIL)
(RESETFORM (INPUT FIL)
(RD])
)
(DEFLIST(QUOTE(
[UREAD (NIL (BEFORE NIL (RETURN (QREAD U]
))(QUOTE READVICE))
(READVISE UREAD)
STOP